100 REM
102 REM*******  ARRAY DIMENSIONS AND INITIALIZATION  *************
104 REM
110 DIM T(580),XX(580),OO(580),MM(580),A(8,8)
120 DIM X4(8),Y4(8)
121 REM  INDX 0=UP           4=DOWN
122 REM       1=UP/RIGHT     5=DOWN/LEFT
123 REM       2=RIGHT        6=LEFT
124 REM       3=DOWN/RIGHT   7=UP/LEFT
125 DATA 0,1,1,1,0,-1,-1,-1
126 FOR I=0 TO 7:READ X4(I):NEXT I
127 DATA -1,-1,0,1,1,1,0,-1
128 FOR I=0 TO 7:READ Y4(I):NEXT I
400 REM
402 REM******** SCREEN PLAY ROUTINE CONTROL **************
404 '
405 PTURN=2
410 GOSUB 1000
412 GOSUB 2000
414 GOSUB 1400:IF MOK=0 GOTO 412
416 GOSUB 1100
418 IF PTURN=1 THEN PTURN=2 ELSE PTURN=1
419 IF (TOTB+TOTW)=32 THEN RUN"blimp
420 IF (TOTB+TOTW)=64 THEN GOSUB 1180:GOTO 19900 ELSE GOSUB 1190
422 GOTO 412
1000 '
1001 '  ********** SUBROUTINE TO INTIIALIZE THE BOARD AND SCREEN ******
1002 '
1010 CLS:KEY OFF:SCREEN 1:COLOR 0,0,0:COLOR ,1
1012 LINE (0,0)-(199,199),1,BF
1014 LINE (3,3)-(27,27),0,B
1016 GET (3,3)-(27,27),T
1018 FOR J=0 TO 7
1020 FOR I=0 TO 7
1022 PUT (I*24+3,J*24+3),T,PSET
1024 NEXT I
1026 NEXT J
1028 X=3:Y=4:CIRCLE (X*24+15,Y*24+15),9,0,,,11/12:PAINT (X*24+15,Y*24+15),0,0
1030 X=4:Y=3:CIRCLE (X*24+15,Y*24+15),9,0,,,11/12:PAINT (X*24+15,Y*24+15),0,0
1032 X=4:Y=4:CIRCLE (X*24+15,Y*24+15),9,0,,,11/12:PAINT (X*24+15,Y*24+15),3,0
1034 X=3:Y=3:CIRCLE (X*24+15,Y*24+15),9,0,,,11/12:PAINT (X*24+15,Y*24+15),3,0
1036 X=1:Y=1:CIRCLE (X*24+15,Y*24+15),5,0,,,11/12:PAINT (X*24+4,Y*24+4),0,0:CIRCLE (X*24+15,Y*24+15),5,2:PAINT (X*24+15,Y*24+15),3,2
1038 GET (1*24+3,1*24+3)-(2*24+3,2*24+3),MM
1040 PUT (1*24+3,1*24+3),T,PSET
1042 X=0:Y=0:PC=1
1044 GET (3*24+3,4*24+3)-(4*24+3,5*24+3),XX
1046 GET (4*24+3,4*24+3)-(5*24+3,5*24+3),OO
1048 PUT (9*24+3,3*24+3),XX,PSET
1050 PUT (9*24+3,5*24+3),OO,PSET
1052 PUT (9*24+3,7*24+3),T,PSET:PUT (9*24+3,7*24+3),MM,XOR
1054 LOCATE 23,32:PRINT "CURSOR"
1056 LOCATE 9,33:PRINT "COUNT"
1058 GOSUB 1190
1062 FOR I=0 TO 7:FOR J=0 TO 7:A(I,J)=0:NEXT J:NEXT I
1064 A(4,4)=1:A(3,3)=1:A(3,4)=2:A(4,3)=2  'NOTE: BLACK=`XX'=`2'  WHITE=`OO'=`1'
1066 TOTW=2:TOTB=2:GOSUB 1100:RETURN
1100 '
1102 '  ********* SUBROUTINE TO PRINT PIECE COUNTS TO SCREEN ***********
1104 '
1110 LOCATE 12,33:PRINT RIGHT$(SPACE$(3)+STR$(TOTB),4):LOCATE 18,33:PRINT RIGHT$(SPACE$(3)+STR$(TOTW),4)
1112 LOCATE 12,33:PRINT RIGHT$(SPACE$(3)+STR$(TOTB),4):LOCATE 18,33:PRINT RIGHT$(SPACE$(3)+STR$(TOTW),4)
1114 RETURN
1120 RETURN
1180 '
1181 ' ********* SUBROUTINE TO SHOWN COMPLETION OF GAME *************
1182 '
1183 PUT (9*24+3,0*24+3),T,PSET
1184 LOCATE 2,32:PRINT " GAME IS":LOCATE 3,34:PRINT "OVER"
1186 RETURN
1190 '
1191 ' ********** SUBROUTINE TO UPDATE SCREEN PLAYER TURN INDICATOR ******
1192 '
1193 IF PTURN=1 THEN PUT (9*24+3,0*24+3),OO,PSET
1194 IF PTURN=2 THEN PUT (9*24+3,0*24+3),XX,PSET
1195 LOCATE 2,32:PRINT "PLAYER'S":LOCATE 3,34:PRINT "TURN"
1196 RETURN
1200 '
1202 ' ******** SUBROUTINE TO MOVE CURSOR ON THE SCREEN *********
1204 '
1208 IF PC=1 THEN GOSUB 1234:PC=0
1210 K$=INKEY$:IF K$="" GOTO 1210 ELSE IF K$=" " GOTO 19999  'SUB FOR INPUT KEY
1212 IF 13=ASC(MID$(K$,1,1)) THEN RETURN
1213 IF 27=ASC(MID$(K$,1,1)) THEN IF PTURN=1 THEN PTURN=2:GOSUB 1190:GOTO 1210 ELSE PTURN=1:GOSUB 1190:GOTO 1210
1214 IF LEN(K$)<>2 GOTO 1210
1216 IF 71=ASC(MID$(K$,2,1)) THEN IF (X=0 OR Y=0) THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X-1:Y=Y-1:GOSUB 1234:GOTO 1210
1218 IF 73=ASC(MID$(K$,2,1)) THEN IF (X=7 OR Y=0) THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X+1:Y=Y-1:GOSUB 1234:GOTO 1210
1220 IF 81=ASC(MID$(K$,2,1)) THEN IF (X=7 OR Y=7) THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X+1:Y=Y+1:GOSUB 1234:GOTO 1210
1222 IF 79=ASC(MID$(K$,2,1)) THEN IF (X=0 OR Y=7) THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X-1:Y=Y+1:GOSUB 1234:GOTO 1210
1224 IF 72=ASC(MID$(K$,2,1)) THEN IF Y=0 THEN BEEP:GOTO 1210 ELSE GOSUB 1234:Y=Y-1:GOSUB 1234:GOTO 1210
1226 IF 75=ASC(MID$(K$,2,1)) THEN IF X=0 THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X-1:GOSUB 1234:GOTO 1210
1228 IF 77=ASC(MID$(K$,2,1)) THEN IF X=7 THEN BEEP:GOTO 1210 ELSE GOSUB 1234:X=X+1:GOSUB 1234:GOTO 1210
1230 IF 80=ASC(MID$(K$,2,1)) THEN IF Y=7 THEN BEEP:GOTO 1210 ELSE GOSUB 1234:Y=Y+1:GOSUB 1234:GOTO 1210
1232 BEEP:GOTO 1210
1234 PUT (X*24+3,Y*24+3),MM,XOR:RETURN   'SUB TO PUT AND TAKE CURSOR ON BOARD
1300 '
1302 ' ******** SUBROUTINES TO PLACE PIECES ON BOARD AND ADJUST COUNTS *****
1304 '
1310 PUT (X*24+3,Y*24+3),T,PSET:A(X,Y)=0:PC=1:RETURN   ' PUT BLANK SPACE ON BOARD
1311 PUT (X*24+3,Y*24+3),XX,PSET:A(X,Y)=PTURN:PC=1:TOTB=TOTB+1:RETURN  'PUT BLACK ON BOARD (B+1)
1312 PUT (X*24+3,Y*24+3),OO,PSET:A(X,Y)=PTURN:PC=1:TOTW=TOTW+1:RETURN  'PUT WHITE ON BOARD (W+1)
1321 PUT (X*24+3,Y*24+3),XX,PSET:A(X,Y)=PTURN:TOTB=TOTB+1:TOTW=TOTW-1:RETURN  'PUT BLACK ON BOARD FOR WHITE (B+1;W-1)
1322 PUT (X*24+3,Y*24+3),OO,PSET:A(X,Y)=PTURN:TOTW=TOTW+1:TOTB=TOTB-1:RETURN  'PUT WHITE ON BOARD FOR BLACK (B-1;W+1)
1400 '
1402 ' ********* SUBROUTINE TO CHECK FOR VALID MOVE ***********
1404 '
1405 MOK=0:IF A(X,Y)<>0 THEN BEEP:GOTO 1440
1407 IF PTURN=1 THEN MPOK=2 ELSE MPOK=1
1410 FOR I=0 TO 7
1412 PCNT=0
1413 FOR J=1 TO 7
1414 IF 0>(X+J*X4(I)) OR 7<(X+J*X4(I)) OR 0>(Y+J*Y4(I)) OR 7<(Y+J*Y4(I)) GOTO 1430
1415 IF A(X+J*X4(I),Y+J*Y4(I))=0 GOTO 1430
1416 IF A(X+J*X4(I),Y+J*Y4(I))=MPOK THEN PCNT=PCNT+1:NEXT J:GOTO 1430
1418 IF A(X+J*X4(I),Y+J*Y4(I))=PTURN THEN GOSUB 1450:GOTO 1430
1430 NEXT I
1435 IF MOK<>0 GOTO 1440
1436 IF PTURN=1 THEN PTURN=2 ELSE PTURN=1
1437 GOSUB 1190
1438 GOTO 1400
1440 RETURN
1450 '
1451 '  ********** SUBROUTINE TO MAKE THE MOVES ON THE BOARD *********
1452 '
1454 IF PCNT<1 GOTO 1466 ELSE X1=X:Y1=Y
1455 IF MOK=0 THEN ON PTURN GOSUB 1312,1311
1456 FOR K=1 TO PCNT
1458 X=X+K*X4(I):Y=Y+K*Y4(I)
1460 ON PTURN GOSUB 1322,1321
1462 X=X1:Y=Y1:NEXT K
1464 MOK=MOK+1
1466 RETURN
2000 '
2005 '  SUBROUTINE TO AUTOMATICALLY PLAY A GAME ON THE BOARD
2010 '  ASSUMES WHITE'S FIRST MOVE AND COORDINATES ARE GIVEN AS
2015 '     X,Y  IN THE RANGE OF 0-7 FOR THE BOARD POSITIONS
2020 '
2021 DATA 5,4,3,5,2,4,5,3,4,2,2,3,4,5,1,5,3,2,4,1,2,1,5,1
2022 DATA 2,2,1,2,3,1,4,0,3,0,5,6,6,3,5,2,6,2,6,5,6,4,2,0
2023 DATA 2,5,2,6,4,6,5,7,3,6,7,5,4,7,5,5,7,3,3,7,2,7,7,2
2024 DATA 6,7,7,4,1,3,0,4,1,7,1,4,6,0,5,0,1,0,1,1,0,1,0,2
2025 DATA 0,0,6,6,7,7,0,5,1,6,7,6,0,6,0,7,6,1,7,1,7,0,0,3
2030 DATA 4,2,5,4,4,5,3,2,2,4,3,5,2,2,2,3,2,5,5,5,5,2,5,3
2035 DATA 5,6,6,3,7,2,4,1,4,0,5,1,5,0,6,2,7,3,5,7,3,1,2,0
2040 DATA 2,1,2,6,2,7,4,6,4,7,1,3,6,7,3,7,0,3,7,7,3,6,1,2
2045 DATA 0,2,1,5,1,4,0,4,0,5,6,4,7,4,7,5,6,5,6,1,7,0,7,1
2050 DATA 6,0,1,1,7,6,6,6,0,1,0,0,1,6,0,6,0,7,1,7,1,0,3,0
2100 IF PC=1 THEN GOSUB 1234:PC=0
2110 READ NX,NY
2120 DX=NX-X:DY=NY-Y:IF DX=0 AND DY=0 GOTO 2200
2130 GOSUB 1234:X=X+SGN(DX):Y=Y+SGN(DY):GOSUB 1234
2140 'K1$=INKEY$:IF K1$="" GOTO 2150
2145 'K1$=INKEY$:IF K1$="" GOTO 2145
2150 GOTO 2120
2200 RETURN
5000 ' ******** SUBROUTINE TO PRINT ARRAY `A' TO PRINTER ***********
5001 '
5002 FOR JJ=0 TO 7
5003 FOR II=0 TO 7
5004 LPRINT A(II,JJ);
5005 NEXT II
5006 LPRINT ""
5007 NEXT JJ
5008 RETURN
19900 K$=INKEY$:IF K$="" GOTO 19900
19910 CLS:LOCATE 10,15:PRINT "ANOTHER GAME?"
19920 K$=INKEY$:IF K$="" GOTO 19920
19930 IF K$<>"Y" AND K$<>"y" GOTO 19999
19935 IF SS=0 THEN RESTORE 2030:SS=1:PTURN=1:GOTO 19950
19940 IF SS=1 THEN RESTORE 2021:SS=0:PTURN=2:GOTO 19950
19950 GOTO 400
19999 LOCATE 5,1:CLS:SCREEN 0:KEY ON:WIDTH 80:END
